home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Display1.Mod (.txt) < prev    next >
Oberon Text  |  1996-02-14  |  4KB  |  108 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. StampElems
  6. Alloc
  7. 14 Feb 96
  8. Syntax10b.Scn.Fnt
  9. Syntax10i.Scn.Fnt
  10. (* AMIGA *)
  11. MODULE Display1;    (* RC 11.12.92, cn 
  12.     IMPORT
  13.         SYSTEM, Amiga,Display,Pictures;
  14.     CONST
  15.         white = 0; grey1 = 1; grey2 = 2; grey3 = 3; grey4 = 4; black = 5;
  16.         texture0 = 6; texture1 = 7; texture2 = 8; texture3 = 9;
  17.         scrPat: ARRAY 10 OF LONGINT;
  18.     PROCEDURE GetPatternSize*(pat: Display.Pattern; VAR w, h: INTEGER);
  19.     (* Returns the pattern size. *)
  20.         VAR p: Amiga.PatternInfoPtr;
  21.     BEGIN p := SYSTEM.VAL(Amiga.PatternInfoPtr, pat); w := p.w; h := p.h
  22.     END GetPatternSize;
  23.     PROCEDURE ThisPattern*(n: INTEGER): Display.Pattern;
  24.     (* Returns the n-th predefined pattern (corresponding to the printer patterns). If the pattern is not available,
  25.         0 is returned. n must be >= 0. Currently 10 patterns are predefined (0 .. 9). *)
  26.     BEGIN
  27.         IF n >= LEN(scrPat) THEN RETURN 0
  28.         ELSE RETURN scrPat[n]
  29.         END
  30.     END ThisPattern;
  31.     PROCEDURE Line*(f: Display.Frame; col, X0, Y0, X1, Y1, mode: INTEGER);
  32.     (* Draws a line from (X0, Y0) to (X1, Y1) inclusive, clipped against F.  For all line points (x, y) the following holds
  33.     always: (min(X0, X1) <= x) & (x <= max(X0, X1) & (min(Y0, Y0) <= y) & (y <= max(Y0, Y1). *)
  34.     BEGIN
  35.         Pictures.Line(Display.screen,f,col,X0,Y0,X1,Y1,mode)
  36.     END Line;
  37.     PROCEDURE Ellipse*(f: Display.Frame; col, X, Y, A, B, mode: INTEGER);
  38.     (* Draws an ellipse with center (X, Y) and radii A and B, clipped against F. For all ellipse points (x, y)  the following holds
  39.         always: (X-A <= x) & (x < X+A) & (Y-B <= y) & (y < Y+B). When A = B the resulting ellipse has the same shape
  40.         as the corresponding circle with R = A. *)
  41.     BEGIN
  42.         Pictures.Ellipse(Display.screen,f,col,X,Y,A,B,mode)
  43.     END Ellipse;
  44.     PROCEDURE Circle*(f: Display.Frame; col, X, Y, R, mode: INTEGER);
  45.     (* Draws a circle with center (X, Y) and radius R, clipped against F. For all circle points (x, y)  the following holds always:
  46.         (X-R <= x) & (x < X+R) & (Y-R <= y) & (y < Y+R). *)
  47.     BEGIN
  48.         Pictures.Circle(Display.screen,f,col,X,Y,R,mode)
  49.     END Circle;
  50.     PROCEDURE Init;
  51.         VAR image: ARRAY 17 OF SET;
  52.         PROCEDURE Repl(step: INTEGER);
  53.             VAR i: INTEGER;
  54.         BEGIN i := step;
  55.             WHILE i < 16 DO image[i+1] := image[i-step+1]; INC(i) END
  56.         END Repl;
  57.     BEGIN
  58.         (*-- initialize screen patterns ---*)
  59.         image[1] := {};
  60.         Repl(1);
  61.         scrPat[white] := Display.NewPattern(image, 16, 16);
  62.         image[4] := {0, 8};
  63.         image[3] := {};
  64.         image[2] := {4, 12};
  65.         image[1] := {};
  66.         Repl(4);
  67.         scrPat[grey1] := Display.NewPattern(image, 16, 16);
  68.         image[2] := {0, 4, 8, 12};
  69.         image[1] := {2, 6, 10, 14};
  70.         Repl(2);
  71.         scrPat[grey2] :=  Display.NewPattern(image, 16, 16);
  72.         image[1] := {0, 2, 4, 6, 8, 10, 12, 14};
  73.         image[0] := {1, 3, 5, 7, 9, 11, 13, 15};
  74.         Repl(2);
  75.         scrPat[grey3] :=  Display.NewPattern(image, 16, 16);
  76.         image[2] := {1..3, 5..7, 9..11, 13..15};
  77.         image[1] := {0, 1, 3..5, 7..9, 11..13, 15};
  78.         Repl(2);
  79.         scrPat[grey4] :=  Display.NewPattern(image, 16, 16);
  80.         image[1] := {0..15};
  81.         Repl(1);
  82.         scrPat[black] := Display.NewPattern(image, 16, 16);
  83.         image[4] :={3, 7, 11, 15};
  84.         image[3] :={2, 6, 10, 14};
  85.         image[2] :={1, 5, 9, 13};
  86.         image[1] :={0, 4, 8, 12};
  87.         Repl(4);
  88.         scrPat[texture0] := Display.NewPattern(image, 16, 16);
  89.         image[4] :={0, 4, 8, 12};
  90.         image[3] :={1, 5, 9, 13};
  91.         image[2] :={2, 6, 10, 14};
  92.         image[1] :={3, 7, 11, 15};
  93.         Repl(4);
  94.         scrPat[texture1] := Display.NewPattern(image, 16, 16);
  95.         image[1] := {2, 6, 10, 14};
  96.         Repl(1);
  97.         scrPat[texture2] := Display.NewPattern(image, 16, 16);
  98.         image[4] := {};
  99.         image[3] := {};
  100.         image[2] := {};
  101.         image[1] := {0..15};
  102.         Repl(4);
  103.         scrPat[texture3] := Display.NewPattern(image, 16, 16)
  104.     END Init;
  105. BEGIN
  106.     Init
  107. END Display1.
  108.